home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / Bonus / VCLZip / kpdemosd.exe / ZipUtil / Compress.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-15  |  6.5 KB  |  246 lines
  1. unit Compress;
  2.  
  3. { $Log:  D:\Util\GP-Version\Archives\VCLZip Zip Utility\UNZIP\Compress.UFV 
  4. {
  5. {   Rev 1.2    Sun 10 May 1998   16:54:57  Supervisor    Version: 2.12
  6. { Version 2.12
  7. }
  8. {
  9. {   Rev 1.1    Tue 24 Mar 1998   19:03:56  Supervisor
  10. { Modifications to allow storing filenames and paths in DOS 
  11. { 8.3 format
  12. }
  13.  
  14.  
  15. interface
  16.  
  17. uses
  18. {$IFDEF WIN32}
  19.     Windows,
  20. {$ELSE}
  21.   WinTypes, WinProcs,
  22. {$ENDIF}
  23.     SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,
  24.   Buttons, ExtCtrls, Dialogs, FileCtrl, Spin;
  25.  
  26. type
  27.   TCompressDlg = class(TForm)
  28.     OKBtn: TButton;
  29.     CancelBtn: TButton;
  30.     Bevel1: TBevel;
  31.     ZipFileGroup: TGroupBox;
  32.     ZipFilename: TEdit;
  33.     ZipFileBtn: TBitBtn;
  34.     GroupBox1: TGroupBox;
  35.     SelectFilesBtn: TBitBtn;
  36.     SelectedFiles: TComboBox;
  37.     GroupBox2: TGroupBox;
  38.     RootDirBtn: TBitBtn;
  39.     RootDir: TEdit;
  40.     RecurseChk: TCheckBox;
  41.     Label6: TLabel;
  42.     Password: TEdit;
  43.     Label1: TLabel;
  44.     ZipAction: TComboBox;
  45.     Label2: TLabel;
  46.     SaveDirInfoChk: TCheckBox;
  47.     ClearBtn: TBitBtn;
  48.     DeleteBtn: TBitBtn;
  49.     GetZipFileDlg: TSaveDialog;
  50.     Wildcards: TEdit;
  51.     AddWildCardBtn: TBitBtn;
  52.     SpinButton1: TSpinButton;
  53.     CompLevel: TLabel;
  54.     DisposeChk: TCheckBox;
  55.     MultiMode: TComboBox;
  56.     MultiModeLabel: TLabel;
  57.     SaveVolumesChk: TCheckBox;
  58.     FirstBlockSize: TEdit;
  59.     BlockSize: TEdit;
  60.     WriteDiskLabelsChk: TCheckBox;
  61.     FirstDiskLabel: TLabel;
  62.     Label4: TLabel;
  63.     RelativeDir: TCheckBox;
  64.     FileSelectDlg: TOpenDialog;
  65.     Store83Format: TCheckBox;
  66.     Label5: TLabel;
  67.     SaveZipInfoChk: TCheckBox;
  68.     procedure ZipFileBtnClick(Sender: TObject);
  69.     procedure SelectFilesBtnClick(Sender: TObject);
  70.     procedure RootDirBtnClick(Sender: TObject);
  71.     procedure ClearBtnClick(Sender: TObject);
  72.     procedure AddWildCardBtnClick(Sender: TObject);
  73.     procedure WildcardsChange(Sender: TObject);
  74.     procedure SpinButton1DownClick(Sender: TObject);
  75.     procedure SpinButton1UpClick(Sender: TObject);
  76.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  77.     procedure DeleteBtnClick(Sender: TObject);
  78.     procedure FormActivate(Sender: TObject);
  79.     procedure SaveDirInfoChkClick(Sender: TObject);
  80.     procedure MultiModeChange(Sender: TObject);
  81.     procedure RootDirChange(Sender: TObject);
  82.   private
  83.     { Private declarations }
  84.   public
  85.     { Public declarations }
  86.   end;
  87.  
  88. var
  89.   CompressDlg: TCompressDlg;
  90.   saveFirstBlockSize: String;
  91.  
  92. implementation
  93.  
  94. {$R *.DFM}
  95.  
  96. procedure TCompressDlg.ZipFileBtnClick(Sender: TObject);
  97. var
  98.   tmpZipName: String;
  99. begin
  100.   If (GetZipFileDlg.Execute) then
  101.    begin
  102.      tmpZipName := GetZipFileDlg.Filename;
  103.      If UpperCase(ExtractFileExt(tmpZipName)) <> '.ZIP' then
  104.         ChangeFileExt( tmpZipName, '.zip' );
  105.      ZipFilename.Text := tmpZipName;
  106.    end;
  107.  
  108. end;
  109.  
  110. procedure TCompressDlg.SelectFilesBtnClick(Sender: TObject);
  111. var
  112.     i: Integer;
  113. begin
  114.   FileSelectDlg.Files.Clear;
  115.   FileSelectDlg.Filename := '';
  116.   {$IFNDEF WIN32}
  117.   FileSelectDlg.Options := FileSelectDlg.Options - [ofNoValidate];
  118.   FileSelectDlg.Title := 'Select File(s) to be compressed';
  119.   {$ENDIF}
  120.   If (FileSelectDlg.Execute) then
  121.      For i := 0 to FileSelectDlg.Files.Count-1 do
  122.             If SelectedFiles.Items.IndexOf(FileSelectDlg.Files[i]) = -1 then
  123.                 SelectedFiles.Items.Add( FileSelectDlg.Files[i] );
  124. end;
  125.  
  126.  
  127. procedure TCompressDlg.RootDirBtnClick(Sender: TObject);
  128. var
  129.   theDir: String;
  130. begin
  131.   theDir := 'C:\';
  132.   If SelectDirectory(theDir, [sdAllowCreate, sdPerformCreate, sdPrompt], 0) then
  133.      RootDir.Text := theDir;
  134. end;
  135.  
  136.  
  137.  
  138. procedure TCompressDlg.ClearBtnClick(Sender: TObject);
  139. begin
  140.   SelectedFiles.Clear;
  141. end;
  142.  
  143. procedure TCompressDlg.AddWildCardBtnClick(Sender: TObject);
  144. begin
  145.   SelectedFiles.Items.Add(WildCards.Text);
  146.   WildCards.Text := '';
  147.   AddWildCardBtn.Enabled := False;
  148. end;
  149.  
  150. procedure TCompressDlg.WildcardsChange(Sender: TObject);
  151. begin
  152.   AddWildCardBtn.Enabled := Length( Wildcards.Text ) > 0;
  153. end;
  154.  
  155. procedure TCompressDlg.SpinButton1DownClick(Sender: TObject);
  156. var
  157.   Value: Integer;
  158. begin
  159.    Value := StrToInt(CompLevel.Caption) - 1;
  160.    If (Value >= 0) and (Value < 10) then
  161.      CompLevel.Caption := IntToStr(Value);
  162. end;
  163.  
  164. procedure TCompressDlg.SpinButton1UpClick(Sender: TObject);
  165. var
  166.   Value: Integer;
  167. begin
  168.    Value := StrToInt(CompLevel.Caption) + 1;
  169.    If (Value > 0) and (Value < 10) then
  170.      CompLevel.Caption := IntToStr(Value);
  171. end;
  172.  
  173. procedure TCompressDlg.FormClose(Sender: TObject;
  174.   var Action: TCloseAction);
  175. begin
  176.   If (ModalResult = mrOK) and (SelectedFiles.Items.Count = 0) then
  177.    begin
  178.      ShowMessage('No files have been specified to be compressed');
  179.      Action := caNone;
  180.    end;
  181. end;
  182.  
  183. procedure TCompressDlg.DeleteBtnClick(Sender: TObject);
  184. begin
  185.   SelectedFiles.Items.Delete( SelectedFiles.ItemIndex );
  186. end;
  187.  
  188. procedure TCompressDlg.FormActivate(Sender: TObject);
  189. begin
  190.   AddWildCardBtn.Enabled := False;
  191.   MultiMode.ItemIndex := 0;
  192.   MultiModeChange( Self );
  193.   saveFirstBlockSize := FirstBlockSize.Text;
  194. end;
  195.  
  196.  
  197. procedure TCompressDlg.SaveDirInfoChkClick(Sender: TObject);
  198. begin
  199.   If SaveDirInfoChk.Checked then
  200.      SaveVolumesChk.Enabled := True
  201.   Else
  202.    begin
  203.      SaveVolumesChk.Checked := False;
  204.      SaveVolumesChk.Enabled := False;
  205.    end;
  206.   RelativeDir.Enabled := (RootDir.Text <> '') and (SaveDirInfoChk.Checked);
  207. end;
  208.  
  209.  
  210.  
  211. procedure TCompressDlg.MultiModeChange(Sender: TObject);
  212. begin
  213.   Case MultiMode.ItemIndex of
  214.           0:  begin   { mmNone }
  215.                  BlockSize.Enabled := False;
  216.                  FirstBlockSize.Enabled := False;
  217.                  WriteDiskLabelsChk.Enabled := False;
  218.               end;
  219.           1:  begin   { mmSpan }
  220.                  BlockSize.Enabled := False;
  221.                  FirstBlockSize.Enabled := True;
  222.                  FirstBlockSize.Text := '0';
  223.                  FirstDiskLabel.Caption := 'Save Space on First Disk';
  224.                  WriteDiskLabelsChk.Enabled := True;
  225.               end;
  226.           2:  begin   { mmBlocks }
  227.                  BlockSize.Enabled := True;
  228.                  FirstBlockSize.Enabled := True;
  229.                  FirstBlockSize.Text := saveFirstBlockSize;
  230.                  FirstDiskLabel.Caption := 'First Block Size';
  231.                  WriteDiskLabelsChk.Enabled := False;
  232.               end;
  233.   end;
  234. end;
  235.  
  236.  
  237. procedure TCompressDlg.RootDirChange(Sender: TObject);
  238. begin
  239.   RelativeDir.Enabled := (RootDir.Text <> '') and (SaveDirInfoChk.Checked);
  240. end;
  241.  
  242.  
  243.  
  244.  
  245. end.
  246.